home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 7
/
Aminet 7 - August 1995.iso
/
Aminet
/
comm
/
cnet
/
FPLogo03.lha
/
FPLOGO.REXX
< prev
Wrap
OS/2 REXX Batch file
|
1995-02-05
|
8KB
|
212 lines
/********** Automaticly generated header, don't edit ************************
*
* PROGRAM: FPLOGO.rexx
*
* PURPOSE: ANSI/ASCII Big Letter Logo creator.
*
* DATE: 05 Feb 95
*
* TIME: 16:16:53
*
* VERSION: 0
* REVISION: 3
* SUBREVISION: 0
*
* COPYRIGHT:
*
* This software is subject to the "Standard Amiga FD-Software Copyright Note"
* It is MAILWARE as defined in paragraph 4b. For more information please
* read "AFD-COPYRIGHT" (Version 1 or higher).
*
* If you create any new fonts for use in FPLOGO, please send them to me, so I
* can include them in future updates!!
*
*
* INSTALLATION:
*
* Create a dir in your PFILES: called FPLOGO, then copy the FPLOGO.rexx
* and the ANSIFont dir to this PFILES:FPLOGO/
*
* Add this to your BBSMENU under '2; Available everywhere':
*
* LOGO | #0PFILES:FPLOGO/FPLOGO.rexx}
*
* You (and your users) can now create (and download) fancy logos or
* signatures, by typing LOGO at any prompt.
*
*
* LOG:
*
* 05 Feb 95 Fixed a small bug in the save routine, and added Install docs.
* 02 Dec 94 Added main GFX screen and cleaned up some code.
* 25 Nov 94 First Version.
*
* ==========================================================================
*
* Another
* _____ __ __ __ __ __ ___ ____ __ __ __ ______
* / ___// / / / / / \ \/ / / _ \ / __ \ / // \/ //_ __/
* / __/ / /__ / /_/ / / / / ___// /_/ // // /\ / / /
* /_/ /____/ \____/ /_/\_\ /_/ \____//_//_/ /_/ /_/
*
* P R O D U C T I O N
*
* Call +45 3526-2527 FIDO 2:235/202.0 CLINK 912:2000/4.0
*
***************************************************************************/
/* revision string for the version command. */
version="$VER: FPLOGO 0.3 (05.02.95)"
options results;signal on error;signal on syntax;signal on ioerr
if ~show('l','rexxsupport.library') then if ~addlib('rexxsupport.library',0,-30,0) then exit
getuser 47;local=result=-1
getuser 23;port=result
getuser 1311992;pfdir=result;fontpath=pfdir'ANSIFont/' /* Path to AFNT fonts */
getuser 1100468;mx=(result-5)*3 /* max numbers to show */
mx=30;nu=1;spa=0 /* Default spacing */
text='';wdir='RAM:FPF'port;wfil=wdir'/FPLOGO.TXT'
transmit 'f1q1'
transmit ' c9ÜÛÛÛÛÛÛÛÜ'
transmit ' ÛÛÛÛ ßßß'
transmit ' ÛÛÛÛÛÛÛÜ cbÖÄÄ· cdÜÜÜ caÛÛßßßßßÛ'
transmit ' c9ÛÛÛÛßßß cbÇÄĽ cdÛ Û caÛÛ ÛÛ Úc2ËÍcaÍÍËc2¿ q1ÚÂÄ¿'
transmit ' c9ÛÛÛÛ cbº cdÛ ÛÜÜÜÜ caÛÛ ÛÛ cf³q1º cfÉÍËq1¿ ³³ ³'
transmit ' c9ßÛÛß cbÐ cdÛÜÜÜÜÜÛ caÛÛÜÜÜÜÜÛ c9Àc1ÊÍc9ÍÍÊc1Ù q1ÀÁÄÙn2'center('The ONLINE Logo Creator!!',78)
transmit 'n1c4'center('FPLOGO v0.2 by PMK. Flux Point Amiga BBS +45 3526 2527',78)'n1q1'
transmit 'n1NOTE: Use LOWERCASE letters, since very few fonts has UPPER/LOWERCASE!'
call makedir(wdir);call NEWTEXT2;call LOADAFNT(REQUEST(fontpath));call SHOWAFNT
do forever
getchar;key=CHECK(result)
select
when key='S' then do;call SPACING;call SHOWAFNT;end
when key='T' then do;call NEWTEXT;call SHOWAFNT;end
when key='F' then do;call LOADAFNT(REQUEST(path));spa=0;call SHOWAFNT;end
when key='D' then do;call SAVEPART;call SHOWAFNT;end
when key='A' then do;call ADDPART;call SHOWAFNT;end
when key='V' then do;call VIEWPART;call SHOWAFNT;end
when key='Q' then leave
otherwise nop
end
end
BYE:;if exists(wfil) then do
prompt 1 noyes 'f1n2Do you want to download the logo you just made [c2Noq1]? '
if CHECK(result)='Yes' then call SAVEPART
call delete(wfil)
end
call delete(wdir);transmit 'f1n1Bye....';exit
SPACING:;transmit 'n1Spacing between chars [0-9]? L1305640#'spa'}I68 1}'
getuser 70;spa=CHECK(result);if spa<0|spa>9 then spa=0;return
NEWTEXT:;transmit 'n1Available chars in 'fnam'n1'ach
NEWTEXT2:;sendstring 'n1Enter text to usen1: L1305640#'text'}I4 40}';getuser 70;text=CHECK(result)
if text='' then signal BYE;return
VIEWPART:;if exists(wfil) then sendstring 'f1* 'wfil'}'
else transmit 'f1n2No logo file made yet!'
transmit 'q1n1Press a key to return to main.g0';return
ADDPART:;transmit 'f1n1Adding text to logo...n1'
call open(1,wfil,word('W A',exists(wfil)+1))
do a=1 to hi;transmit fin.a;call writeln(1,fin.a);end;call close(1)
transmit 'q1n1Press a key to return to main.g0';return
SAVEPART:;transmit 'f1';if exists(wfil) then do
if local then do
prompt 25 normal 'n1Copy to path: ';cdir=CHECK(result)
if right(cdir,1)~='/'&right(cdir,1)~=':' then do
sendstring 'n1Not a legal Pathname!! - Press a key to continue.g0';return;end
else do
sendstring 'Copying logo file to 'cdir
address command 'copy 'wfil' to 'cdir
end
end
else xdn wfil
call delete(wfil)
end
else transmit 'n1No logo file made yet!'
transmit 'n1Press a key to return to main.g0';return
SHOWAFNT:;fin.=''
transmit 'f1cfz4'left(fnam,78)'n1z4'left(fcre,78)'n1z4'left('Type : 'word('MONO COLOR',ct+1),78)'n1z4'left('Text : 'text,78)'q1n1'
do i=1 to length(text)
c=c2d(substr(text,i,1))+1;if substr(legal,c,1)='*' then do
do b=1 to hi;fin.b=fin.b||char.c.b||copies(' ',spa);end
end
end
do a=1 to hi;transmit fin.a;end
transmit 'n1q1z4cf'left(' [c3Acf]dd to Logo [c3Dcf]ownload [c3Fcf]ont [c3Scf]pacing [c3Tcf]ext [c3Vcf]iew [c1Qcf]uit',120)'q1'
return
LOADAFNT:;arg afnt;if ~open(1,afnt,'R') then signal BYE
sendstring 'f1Loading '
fnam=readln(1);fcre=readln(1);z=readln(1);parse var z wi' 'hi' 'ba' 'ct .
z=readln(1);z=readln(1);legal=readln(1);z=readln(1);ach=''
do a=1 to length(legal)
if substr(legal,a,1)='*' then do
sendstring '.';ach=ach||d2c(a-1);do b=1 to hi;char.a.b=readln(1);end
end
end
call close(1);return
REQUEST:;arg path
do forever
di=showdir(path,'D');do a=2 to words(di)+1;it.a=word(di,a-1)'/';end
fi=showdir(path,'F');do b=a to a+words(fi);it.b=word(fi,b-a+1);end
it=b-2;mset=it%mx+1;it.1=word('<<Parent <Root>',(nu=1)+1);set=0;file=1
do until file~=1
p=1;s=p+set*mx;file=''
transmit 'f1z4c7 'centre('Contents of directory "'path'"',78)'q1'
do a=s to it for mx;sendstring left(it.a,22)substr(' n1',(a//3=0)*3+1,3);end
sendstring at(mx/3+2,1)'z4c7 'centre('Cursorkeys to Move, RETURN to Select. Page 'set+1' of 'mset,78)'q1n1'at(p%3+2,(p//3-1)*26)'r1'it.s'r0'
tz=a-s
do while file=''
key=GETCURSOR();select
when key='2'&p<tz-2 then p=ccur(3)
when key='4'&p>1 then p=ccur(-1)
when key='6'&p<tz then p=ccur(1)
when key='8'&p>3 then p=ccur(-3)
when key='2'&tz+set*mx<it then do;set=set+1;file=1;end
when key='8'&p~=s then do;set=set-1;file=1;end
when key='5' then file=it.s
when key='!' then signal BYE /* Panic Exit! */
otherwise nop /*sendstring at(1,1)'r1'key'r0'*/
end
end
end
select
when file=it.1 then do
if nu~=1 then do
nu=nu-1;tp=left(path,length(path)-1);
path=left(path,max(lastpos('/',tp),lastpos(':',tp)))
end
end
when right(file,1)='/' then do;nu=nu+1;path=path||file;end
otherwise leave
end
end
return path||file
CCUR:
sendstring at((p-1)%3+2,((p-1)//3)*25+1)it.s;p=p+ARG(1);s=p+set*mx
sendstring at((p-1)%3+2,((p-1)//3)*25+1)'r1'it.s'r0';return p
AT:;return ''arg(1)';'arg(2)'H'
GETCURSOR: procedure;do until key~='NOCHAR';maygetchar;key=result;end
if key='1B'x then do 2;maygetchar;key=result;end;else if key='D'x then return '5';else return upper(key)
if key='A' then return '8';if key='B' then return '2';if key='C' then return '6';if key='D' then return '4'
return upper(key)
CHECK:;if ARG() & ARG(1)~='###PANIC' then return ARG(1)
getcarrier;if result='TRUE' then if ARG() then return ARG(1);else return
call delete(wfil);call delete(wdir);logentry 'Lost Carrier!!';bufferflush;exit
ERROR:;IOERR:;SYNTAX:;em='Error in line: 'sigl' Code: 'errortext(rc);
logentry em;transmit em;bufferflush;exit